home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
wedits22.zip
/
WWIVEDIT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-19
|
30KB
|
1,138 lines
{$M 16000,0,655360}
PROGRAM WWIVEdit(Input,Output);
(******************************************************************************
** **
** WWIVEdit Version 2.2 **
** Last Modified : 8/19/91 **
** By Adam Caldwell (The Emporer) **
** 1@ 16401 (Link) [The First Galactic Empire (Link)] **
** 1@ 6470 (Net) [The First Galactic Empire (Net) ] **
** 718@ 5252 (Net) [Dragon's Den (Net) ] **
** Phone: (614) 593-7836 [ Link BBS ] **
** **
** Purpose : WWIV is a full screen editor designed specifically for use with**
** the WWIV 4.xx BBS system. It takes advantage of many of the features **
** features of WWIV such as colors, Macros, and WWIV specific formatting **
** functions. **
** It is a Word Processor like editor that I have written to be **
** easily Extendable (if you understand my programming style :-) **
** **
** This source code is Limited Public Domain. By this I mean that you may **
** freely modify and distribute this source code so long as: **
** 1) No Fee is charged for this or any product derived from this code **
** 2) Any modifications that you make are CLEARLY noted as not being **
** my code (ie, initial it) if you distrubute modified versions **
** 3) You don't change this message header in any way [including removal **
** of it] **
** 4) No NOT use the naming convention WEDITSxx.ZIP when distributing it **
** This is reserved for *official* releases **
** **
******************************************************************************)
{{$DEFINE DEBUG} { Remove first comment symbol to make actually define it }
{{$DEFINE DIRECTVIDEO} { Don't define either of these for the BBS }
{$DEFINE OVERLAY} { UnDefine if you don't want overlays }
{$DEFINE VERSION_2_2} { Doesn't do anything... Just there so you know what version it is }
{$IFDEF DEBUG}
{$R+,V+,S+,B-,E-,N-} { These were used to find a bunch of little bugs :-) }
{$ELSE}
{$R-,V-,S-,B-,E-,N-} { These Optomize things as much as possible }
{$ENDIF}
USES DOS, WEMisc,WEVars, WEDict, WEKbd, WETime, WEString,
WELine, WEOutput, WEChat, WEInit, WEInput, WETag{, WEDefaul}
{$IFDEF OVERLAY}
,Overlay
{$ENDIF}
{$IFDEF DIRECTVIDEO} {-- This unit uses the CRT unit. I wrote this because I needed}
,WWIVOutp {-- to debug this code on a system without an ANSI driver.}
{$ENDIF}; {-- It is also used to "simulate" 12/2400 bps modems... Available upon request }
{$IFDEF OVERLAY}
{$O WEChat}
{$O WEDict}
{$O WEInit}
{$O WETag}
{$O WEMisc}
{{$O WEDefaul} { ** Future Enhancement ** }
{$ENDIF}
PROCEDURE ScrollWindowDown;
{ Moves the viewport down on the Text Buffer }
VAR x:integer;
BEGIN
IF cy>MaxLines THEN cy:=MaxLines-1;
x:=cy-ViewTop;
cy:=cy+WindowHeight-MinScrollLeft;
ViewTop:=cy-x;
ViewBottom:=ViewTop + WindowHeight;
IF viewBottom>MaxLines THEN BEGIN
ViewBottom:=MaxLines-1;
ViewTop:=ViewTop-WindowHeight;
cy:=ViewBottom;
END;
END;
PROCEDURE ScrollWindowUp;
VAR x:integer;
{ Moves the Viewport Up on the Text Buffer }
BEGIN
IF cy<1 THEN cy:=1;
x:=cy-ViewTop;
cy:=cy-WindowHeight+MinScrollLeft;
ViewTop:=cy-x;
ViewBottom:=ViewTop+WindowHeight;
IF ViewTop<1 THEN BEGIN
ViewTop:=1;
cy:=1;
ViewBottom:=ViewTop + WindowHeight;
END;
END;
FUNCTION Done(VAR Cmd:EdFun):boolean;
{ Asks whether or not user wants to save, Abort, or Resume, and handles
calls to EditTagline }
VAR
ch:char;
OkSet : CharSet;
TagS:string;
TagCh:string;
BEGIN
Ansic('0');
OkSet:=['A','S','R','D',ESC];
IF NOT (Cmd IN [AbortPost,QuietExitAndSave]) THEN
BEGIN
IF OkTagLines THEN BEGIN
TagS:=', '+C1+'T'+C2+'aglines';
OkSet:=OkSet+['T'];
TagCh:='T'
END ELSE BEGIN
TagS:='';
TagCh:=''
END;
StatusLine3(C1+'A'+C2+'bort, '+C1+'S'+C2+'ave, '+C1+'R'+C2+'esume'+
{C1+'D'+C2+'efaults'}+TagS+' [ASR'+TagCh+'] > '+C1);
IF Cmd=ExitAndSave
THEN ch:='S'
ELSE ch:=ReadSet(OkSet);
IF ch=#27 THEN ch:='R';
ansic('0');
IF ch='A' THEN
BEGIN
gotoxy(6,WindowBottom+1);
clreol;
prompt(' '+C6+'Are you sure?'+C2+' [yN] '+C1);
ch:=ReadSet(['Y','N',ENTERKey,ESC]);
IF ch <>'Y'
THEN ch:='R'
ELSE ch:='A'
END;
IF ch='R' THEN
BEGIN
StatusLine3('');
ShowMaxLines
END
ELSE IF Ch='T' THEN
BEGIN
EditTaglines;
ForcedRedisplay;
END {
ELSE IF ch='D' THEN
BEGIN
EditDefaults;
ForcedRedisplay;
END};
Done:=ch IN ['S','A'];
IF ch ='A' THEN nl;
IF ch='S' THEN cmd:=ExitAndSave;
END;
END;
{$F+}
VAR lx,ly:integer;
PROCEDURE ShowWhere;
{ Procedure Called by GetKey (as the BeforeNext procedure) to display the
cursor position. It must be activated (by ^KW) }
VAR x,y:byte;
BEGIN
IF (lx<>cx) OR (ly<>cy) THEN
BEGIN
IF Local THEN writescreen(cstr(cx)+':'+cstr(cy)+' ',1,ScreenHeight-3,7)
ELSE
BEGIN
x:=wherex; y:=wherey;
statusline3(c0+cstr(cx)+':'+cstr(cy));
Gotoxy(x,y);
END;
END;
lx:=cx; ly:=cy;
END;
{$F-}
PROCEDURE DoToggleWhere;
{ Installs/uninstalls The ShowWhere procedure into the BeforeNext procedure }
BEGIN
IF @BeforeNext=@DoNothing THEN
BEGIN
BeforeNext:=ShowWhere;
lx:=-1;
END
ELSE BEGIN
BeforeNext:=DoNothing;
StatusLine3(C0);
END;
END;
PROCEDURE Help;
{ Prints out the Help file and then causes a redisplay afterward }
PROCEDURE GotoP(x:integer);
BEGIN
gotoxy(20*((x-1) mod 4)+1,((x-1) div 4) +2);
END;
VAR
ch:char;
x:integer;
top : integer;
s,topic : string;
fun : EdFun;
t:text;
topics : array[1..80] OF String[20];
nfound : integer;
BEGIN
ansic('0');
assign(t,StartupDir+'WWIVEDIT.HLP');
topic:='';
nfound := 0;
{$I-} reset(t); {$I+}
IF IOResult=0 THEN
BEGIN
REPEAT
readln(t,s);
UNTIL s='START';
REPEAT
readln(t,s);
IF s<>'END' THEN BEGIN
inc(nfound);
topics[nfound]:=s;
END;
UNTIL s='END';
IF Local THEN
BEGIN
REPEAT
readln(t,s);
UNTIL s='LOCAL';
REPEAT
readln(t,s);
IF s<>'END' THEN BEGIN
inc(nfound);
Topics[nfound]:=s;
END;
UNTIL s='END'
END;
END;
top:=1;
IF Nfound<>0 THEN
REPEAT
clrscr;
Print(C5+'Available Help Topics: '+C2+'['+c1+'Press '+C5+'ESC'+C1+' to Exit, or '+
C5+'ENTER'+C1+' to Choose Topic'+C2+']');
FOR x:=1 TO Nfound DO
BEGIN
GotoP(x);
IF x=top
THEN ansic('4')
ELSE ansic('0');
prompt(Topics[x]);
END;
GotoP(top);
REPEAT
fun:=GetArrow;;
IF fun IN [Up,Down,Left,Right] THEN
BEGIN
ansic('0');
write(Topics[Top]);
CASE fun OF
Up : Dec(Top,4);
Down : Inc(Top,4);
Left : Dec(Top);
Right: Inc(Top);
END;
IF Top<1 THEN Top:=Top+NFound
ELSE IF Top>NFound THEN Top:=Top-NFound;
GotoP(top);
ansic('4');
write(Topics[Top]);
GotoP(top);
END;
UNTIL Fun IN [Enter,NormalExit];
IF fun=NormalExit
THEN Topic:=''
ELSE Topic:=Topics[Top];
IF Fun=GetHelp THEN Topic:='HELP ON HELP';
Topic:=TransformString(Topic);
IF Topic<>'' THEN BEGIN
reset(t);
gotoxy(1,22);
prompt(C2+'Searching...');
REPEAT
readln(t,s);
UNTIL (s='EOF') OR (s=Topic+':') OR ((s=Topic+';') AND Local);
IF s='EOF' THEN print(C6+'Topic Not Found'+C0)
ELSE BEGIN
REPEAT
readln(t,s);
UNTIL s='SOT';
clrscr;
print(c7+'Topic '+c3+': '+c1+Topic);
REPEAT
readln(t,s);
IF s[length(s)]=^A THEN delete(s,length(s),1);
IF s[length(s)]=' ' THEN delete(s,length(s),1);
IF s='.P' THEN BEGIN
PauseScr;
ClrScr;
END
ELSE IF cmpleft(s,^B) THEN Center(RightS(s,Length(s)-1))
ELSE IF s<>'EOT' THEN
print(C0+s);
UNTIL (s='EOT') OR CheckAbort;
END;
close(t);
END;
UNTIL topic=''
ELSE BEGIN
print(c6+'Help file not found!'+c0);
prompt(c3+'Press any key to return to the editor.'+c0);
ch:=GetKey;
END;
ForcedRedisplay;
END;
PROCEDURE ForceDone;
{ Yell at the user for going over line limit }
BEGIN
StatusLine1(c6+'No More Lines Left.'+chr(7)+c0);
END;
PROCEDURE ReadInputFile(lines:integer; FileName:String);
{ Reads in an input file at the given line number }
VAR t:text;
ccol:integer;
ch:char;
i:integer;
CurColor:char;
s:string;
f:file of byte;
BytesRead:LongInt;
Step : LongInt;
printed : integer;
BEGIN
assign(t,Filename);
{$I-} reset(t); {$I+}
IF IOResult=0 THEN
BEGIN
BytesRead:=0;
assign(f,Filename);
reset(f);
Step := FileSize(f) DIV 20;
close(f);
curcolor:='0';
ccol:=1;
prompt(C2+'Loading File '+C3+': '+C0+dup('░',20)+ESC+'[20D');
Printed:=0;
ansic('1');
WHILE (NOT EOF(t)) AND (Lines<MaxLines) DO
BEGIN
Drain;
readln(t,s);
BytesRead:=BytesRead+Length(s)+1;
WHILE BytesRead DIV Step >= Printed DO
BEGIN
write('█');
inc(Printed);
END;
inc(lines);
ccol:=1;
CurColor:='0';
IF (s[length(s)]=^A) AND (s[length(s)-1]=' ') THEN
delete(s,length(s)-1,1);
WHILE s<>'' DO
IF NOT (s[1] IN [^A,^B,^C]) THEN
BEGIN
IF ccol>LineLen THEN BEGIN
inc(Lines);
Line[lines]^.HardCR:=False;
ccol:=1;
END;
Line[lines]^.l:=Line[lines]^.l+s[1];
Line[Lines]^.c:=Line[Lines]^.c+CurColor;
delete(s,1,1);
inc(ccol);
END
ELSE BEGIN
IF s[1]=^B THEN
BEGIN
IF ccol<>1 THEN BEGIN
Line[Lines]^.HardCr:=TRUE;
ccol:=1;
inc(Lines);
END;
Line[Lines]^.l:='/C:';
Line[Lines]^.c:='000';
delete(s,1,1);
END
ELSE IF s[1]=^C THEN
BEGIN
CurColor:=s[2];
delete(s,1,2);
END ELSE IF s[1]=^A THEN
BEGIN
Line[Lines]^.HardCR:=FALSE;
delete(s,1,1);
END;
END;
END;
close(t);
ansic('0');
END;
HighLine:=Lines;
END;
FUNCTION CheckDest:boolean;
VAR
t:text;
s:string;
ok, NeedOK:boolean;
BEGIN
ok:=TRUE;
NeedOK:=false;
Assign(t,StartUpDir+'NOTAG');
{$I-} reset(t); {$I+}
IF IOResult=0 THEN
BEGIN
WHILE (NOT EOF(t)) AND OK DO
BEGIN
Readln(t,s);
IF s[1]='"' THEN BEGIN
Delete(s,1,1);
Delete(s,length(s),1)
END;
IF pos(s,Destination)>0 THEN ok:=FALSE;
END;
close(t);
END;
CheckDest:=OK;
END;
PROCEDURE WriteOutputFile(VAR ReturnCode:integer);
{ Writes output file... could use some color optimizations }
VAR
t, t1:text;
l,x,i:integer;
ch:char;
ccol : integer;
curcolor : char;
plural:string[1];
ignore : integer;
s,s1:string;
BBSTag:Text;
dummy : integer;
sr : SearchRec;
Nfound : integer;
BEGIN
dummy:=returncode;
nfound :=0;
assign(t,Filename);
l:=MaxLines;
WHILE (l>0) AND (Line[l]^.l='') DO
dec(l);
s:=TransformString(Line[l]^.L);
IF (length(s)>2) AND (s='/ES') THEN
Delete(s,2,1); { Remove the E }
IF s='/SN' THEN ReturnCode := NonAnonymousReturnCode
ELSE IF s='/SY' THEN ReturnCode := AnonymousReturnCode
ELSE ReturnCode:=NormalReturnCode;
IF cmpLeft(s,'/S') THEN dec(l);
IF l>1
THEN plural:='s'
ELSE plural:='';
IF l>0 THEN
BEGIN
nl;
s:=C7+'Saving '+C1+cstr(l)+C7+' line'+plural+'... '+C0;
IF OKTaglines
THEN OkTaglines:=OKTaglines AND CheckDest;
IF dummy=0
THEN prompt(s)
ELSE StatusLine3(s);
clreol;
CurColor:='0';
ignore:=0;
rewrite(t);
FOR x:=1 TO l DO
BEGIN
CurColor:='0';
s1:=Line[x]^.l;
s:=TransformString(s1);
IF (length(s)>1) AND (s[1]='/') THEN
BEGIN
IF cmpLeft(s,'/ES') OR cmpLeft(s,'/S') THEN
BEGIN
Line[x]^.l:='';
s1:='';
END
ELSE IF cmpLeft(s,'/C:') THEN
BEGIN
Delete(Line[x]^.c,1,3);
Insert('000',Line[x]^.c,1);
END;
END;
ccol:=1;
FOR i:=1 TO length(s1) DO
IF Color(Line[x]^,i)<>CurColor THEN
BEGIN
CurColor:=Color(Line[x]^,i);
insert(^C+CurColor,s1,ccol);
inc(ccol,3);
END ELSE inc(ccol);
IF cmpLefti(s1,'/C:') THEN
BEGIN
delete(s1,1,3);
insert(^B,s1,1);
END;
{ IF NOT (Line[x]^.HardCR) AND (s1[length(s1)]<>' ') THEN
s1:=s1+' ';}
IF Line[x]^.HardCR
THEN writeln(t,s1)
ELSE writeln(t,s1+^A);
END;
IF curColor<>'0' THEN write(t,C0);
IF info.selected>3 THEN
BEGIN
info.selected:=3;
WHILE (info.selected>0) AND (info.Tagline[info.selected]<>'') DO
dec(info.selected);
END;
IF OkTagLines AND NOT FileThere AND
(info.selected>0) AND
(info.method<>0) AND (info.method<>6) AND
(info.Tagline[info.selected]<>'') AND
(ReturnCode <> AnonymousReturnCode) THEN
BEGIN
prompt(C2+'Writing Personal Tag Line... '+C0);
FindFirst(StartupDir+'WWIVEDIT.DIV',0,sr);
IF DOSError<>0 THEN
writeln(t,'-----')
ELSE BEGIN
assign(t1,StartUpDir+'WWIVEDIT.DIV');
reset(t1);
readln(t1,s);
writeln(t,s);
close(t1);
END;
ccol:=1;
WHILE ccol<length(info.Tagline[1])-3 DO
BEGIN
IF copy(TransformString(info.Tagline[1]),ccol,3)='/C:' THEN
BEGIN
delete(info.Tagline[1],ccol,3);
insert(^B,info.Tagline[1],ccol);
END;
inc(ccol);
END;
ccol:=1;
FOR i:=1 TO Length(info.Tagline[info.selected]) DO
WITH info DO
BEGIN
IF TagLine[selected][i]=^M THEN
BEGIN
writeln(t);
ccol:=1;
END
ELSE IF TagLine[selected][i]=^N THEN
BEGIN
write(t,^H);
dec(ccol)
END
ELSE IF TagLine[selected][i] IN [^P,^C] THEN
BEGIN
write(t,^C);
CurColor:=TagLine[selected][i+1];
dec(ccol,1);
END ELSE IF TagLine[selected][i] IN [^B,#32..#255]-[#127] THEN
BEGIN
write(t,TagLine[selected][i]);
inc(ccol)
END
END;
IF ccol<>1 THEN writeln(t);
END;
IF AddBBSTag AND (NOT FileThere) AND CheckDest THEN
BEGIN
prompt(c5+'Writing BBS tagline... '+c0);
findfirst(StartupDir+'BBS*.TAG', 0, sr);
WHILE DOSError=0 DO
BEGIN
inc(nfound);
FindNext(sr);
END;
nfound:=random(nfound)+1;
findfirst(StartupDir+'BBS*.TAG', 0, sr);
dec(nfound);
WHILE nfound>0 DO
BEGIN
dec(nfound);
FindNext(sr);
END;
writeln(t);
assign(bbstag,StartupDir+sr.name);
reset(bbstag);
WHILE not EOF(bbsTag) DO
BEGIN
read(bbsTag,ch);
write(t,ch)
END;
close(bbstag);
END;
close(t);
END;
IF dummy<>0 THEN statusline3(C0);
IF (l=0) AND FileThere THEN BEGIN
nl;
clreol;
print(c2+'File erased'+C0);
erase(t);
END
ELSE IF l=0 THEN
BEGIN
nl;
clreol;
Print(c0+'Aborted');
END;
END;
PROCEDURE DoBackspace;
{ All this just because the user hits the Backspace (or Delete) }
VAR
temp:LineType;
Ins:boolean;
BEGIN
Ins:=InsertMode; { Save the current InsertMode State }
InsertMode:=True; { Set insert mode on }
IF cx > 1 THEN BEGIN { If we aren't in the first column, things are easy }
LDelete(cy,cx-1,1); { Just delete the character to the left of }
dec(cx); { the cursor and back up }
reformat(cy,false);
END
ELSE IF len(cy)=0 THEN BEGIN { Special case for if there isn't anything }
DeleteLine(cy); { On the line we are backspacing from }
dec(cy);
cx:=Len(cy)+1;
END
ELSE IF cy>1 THEN BEGIN { Otherwise, the user wants to join two lines }
dec(cy); { Back up one line }
cx:=len(cy)+1; { move to the end of it }
IF (cx=1) THEN
DeleteLine(cy)
ELSE BEGIN
Line[cy]^.hardCR:=false;
Reformat(cy,false); { Reformat everything now to shorten the line }
END;
END;
InsertMode:=Ins; { Go back to current insert state }
END;
PROCEDURE DoCenterLine(VAR cy:integer);
{ Places the centering code at the beginning of the line }
VAR
Space:LineType;
ins : boolean;
BEGIN
Ins:=InsertMode;
InsertMode:=true;
Space.l:='/C:';
Space.c:='000';
IF (Len(cy)>0) AND (Len(cy)<LineLen-3) THEN
LInsert(Space,cy,1);
cx:=1;
IF cy<MaxLines THEN inc(cy);
InsertMode:=ins;
END;
PROCEDURE ShowBlockStatus;
BEGIN
StatusLine3('Block Begin Line '+cstr(BlockStart)+', Block Ending Line '+cstr(BlockEnd));
AfterNext:=ClrStatLine3;
END;
PROCEDURE DoDeleteBlock(startline,endline:integer);
VAR
i:integer;
BEGIN
IF EndLine>=StartLine THEN
FOR i:=0 TO endline-startline DO
DeleteLine(Startline);
END;
PROCEDURE DoBlockCopy(VAR startline,endline:integer; toline:integer);
VAR
x:integer;
o : integer;
i : integer;
BEGIN
IF (ToLine+EndLine-StartLine<MaxLines) AND (startline>0) AND
(startline<=endline) AND ((toline>endline) OR (toline<=startline)) THEN
FOR i:=0 TO EndLine-StartLine DO
BEGIN
InsertLine(toline,Line[i+StartLine]^);
inc(toline);
END;
END;
PROCEDURE DoBlockMove(VAR BlockStart,BlockEnd:integer; ToLine:integer);
VAR x:integer;
BEGIN
x:=BlockStart;
IF ToLine>BlockStart
THEN x:=ToLine-BlockEnd+BlockStart-1
ELSE x:=ToLine;
DoBlockCopy(BlockStart,BlockEnd,ToLine);
DoDeleteBlock(BlockStart,BlockEnd);
BlockEnd:=x+BlockEnd-BlockStart;
BlockStart:=x;
ShowBlockStatus;
END;
PROCEDURE DoInsertFile;
{ Prompt for a file name and then read it in at the end of the current
Text Buffer }
VAR
s : string;
BEGIN
StatusLine3(C2+'File Name read in > '+C1);
readln(s);
StatusLine3(C0);
IF s<>'' THEN ReadInputFile(HighLine,s);
StatusLine3('');
ShowHeader;
END;
PROCEDURE PrintOutput;
{ Prints the current text buffer to the screen }
VAR
i, j, s : integer;
ccol : char;
BEGIN
clrscr;
ccol:='0';
ansic(ccol);
print(title);
i:=0;
WHILE i < Highline DO
BEGIN
inc(i);
IF cmpLeftI(Line[i]^.l,'/C:') THEN
Center(RightS(Line[i]^.l,len(i)-3))
ELSE
FOR j:=1 TO Len(i) DO
BEGIN
IF Line[i]^.c[j]<>ccol THEN BEGIN
ccol:=Line[i]^.c[j];
ansic(ccol);
END;
prompt(Line[i]^.l[j]);
END;
IF checkAbort THEN i:=HighLine;
writeln;
ccol:='0';
ansic('0');
END;
pausescr;
ForcedRedisplay;
END;
PROCEDURE DoSaveAndContinue;
VAR dummy:integer;
BEGIN
dummy:=-1;
WriteOutputFile(dummy);
END;
PROCEDURE DoEnter;
BEGIN
IF cx<=Len(cy) THEN
BEGIN
Line[0]^.l:=copy(Line[cy]^.l,cx,len(cy)-cx+1);
Line[0]^.c:=copy(Line[cy]^.c,cx,len(cy)-cx+1);
LDelete(cy,cx,len(cy)-cx+1);
inc(cy);
InsertLine(cy,Line[0]^);
InitLine(Line[0]^);
cx:=1;
Line[cy]^.HardCR:=Line[cy-1]^.hardCR;
Reformat(cy,false);
END
ELSE BEGIN
inc(cy);
cx:=1;
InitLine(Line[0]^);
InsertLine(cy,Line[0]^);
END;
Line[cy-1]^.HardCR := TRUE;
END;
PROCEDURE DoDelChar;
BEGIN
inc(cx);
IF cx>Len(cy)+1 THEN
BEGIN
dec(cx);
IF Len(cy+1)=0 THEN
DeleteLine(cy+1)
ELSE BEGIN
Line[cy]^.HardCR:=False;
Reformat(cy,false);
END;
END
ELSE DoBackspace;
END;
PROCEDURE DoTab;
VAR
Temp : LineType;
BEGIN
IF cx < LineLen - TabStop THEN
REPEAT
MakeString(temp,' ',CurrentColor);
LInsert(Temp,cy,cx);
Reformat(cy,False);
inc(cx);
UNTIL (cx-1) mod TabStop =0;
END;
PROCEDURE DoToggleScreen;
BEGIN
IF ScreenState=0 THEN BEGIN
ScreenState:=1;
WindowTop:=1;
WindowBottom:=ScreenHeight-3;
END
ELSE IF ScreenState=1 THEN BEGIN
ScreenState:=2;
WindowTop:=3;
END
ELSE BEGIN
ScreenState:=0;
WindowTop:=5;
WindowBottom:=ScreenHeight-4;
END;
WindowHeight:=WindowBottom-WindowTop;
ViewBottom:=ViewTop+WindowHeight;
ForcedRedisplay;
END;
FUNCTION DoFun(fun:edfun; VAR ch:char):edfun;
BEGIN
CASE fun OF
BackSpace : IF ((cy=1) AND (cx>1)) OR (cy>1) THEN
DoBackspace;
Bottom : cy:=highline+1;
CenterLine : DoCenterLine(cy);
CopyBlock : DoBlockCopy(BlockStart,BlockEnd,cy);
DelChar : DoDelChar;
DelEOL : LDelete(cy,cx,len(cy)-cx+1);
DeleteBlock : BEGIN
cy:=BlockStart;
DoDeleteBlock(BlockStart,BlockEnd);
END;
DelLine : BEGIN cx:=1; DeleteLine(cy); END;
DelSOL : BEGIN
LDelete(cy,1,cx-1);
cx:=1;
END;
Down : IF cy<MaxLines THEN inc(cy);
_end : cx:=len(cy)+1;
Enter : DoEnter;
EraseWordLeft:BEGIN
WHILE (cx>1) AND (character(cy,cx-1)=' ') DO
DoBackspace;
WHILE (cx>1) AND (character(cy,cx-1)<>' ') DO
DoBackspace;
END;
Find : DoSearch;
FindLast : SearchLast;
GetHelp : Help;
GoBack : BEGIN
fun:=InsertChar;
ch:=^H;
END;
Home : cx:=1;
InsertFile : DoInsertFile;
InsLine : insertLine(cy,Line[0]^);
Jump : DoJump;
Left : BEGIN
dec(cx);
IF (cx=0) AND (cy>1) THEN
BEGIN
cx:=len(cy-1)+1;
dec(cy)
END
END;
MarkEnd : BEGIN BlockEnd := cy; ShowBlockStatus END;
MarkStart : BEGIN BlockStart := cy; ShowBlockStatus END;
MoveBlock : DoBlockMove(BlockStart,BlockEnd,cy);
PgDn : ScrollWindowDown;
PgUp : ScrollWindowUp;
RedisplayAll: ForcedRedisplay;
Right : BEGIN
inc(cx);
IF cx>LineLen+1 THEN
BEGIN
inc(cy);
cx:=1
END;
END;
SaveAndContinue: DoSaveAndContinue;
ShowBlockStat:ShowBlockStatus;
Tab : DoTab;
ToggleInsert: BEGIN InsertMode:=NOT InsertMode; ShowMaxLines; END;
ToggleFullScreen : DoToggleScreen;
ToggleWhere : DoToggleWhere;
Top : cy:=1;
Up : IF cy>1 THEN dec(cy);
WordLeft : Cx:=GoLeft(Line[cy]^.l,cx);
WordRight : cx:=GoRight(Line[cy]^.l,cx);
WWIVColor : BEGIN
ch:=GetKey;
IF MCICommands AND (ch IN ['g'..'z','G'..'Z']) THEN
fun:=InsertMCI
ELSE
IF colorRangeCheck THEN
IF Cmap[ch] THEN
CurrentColor:=ch
ELSE
ELSE CurrentColor:=ch;
END;
END;
DoFun:=Fun;
END;
PROCEDURE DoSlash(VAR fun : Edfun);
VAR
s:string;
dummy:char;
BEGIN
s:=TransformString(Line[cy-1]^.l);
IF s='/HELP' THEN
BEGIN
DeleteLine(cy-1);
dec(cy);
Help;
END;
IF s='/CLR' THEN
BEGIN
FOR cy:=1 TO MaxLines DO
InitLine(Line[cy]^);
cy:=1;
END;
IF s='/RL' THEN
BEGIN
dec(cy,2);
DeleteLine(cy);
DeleteLine(cy);
END;
IF s='/LI' THEN
BEGIN
dec(cy);
DeleteLine(cy);
PrintOutput;
END;
IF (s='/TI') AND AllowTitleChange THEN
BEGIN
dec(cy);
DeleteLine(cy);
gotoxy(9,1);
ansic('1');
clreol;
input(s,60);
IF s<>''
THEN Title:=s
ELSE BEGIN gotoxy(9,1); ansic('1'); prompt(title); END;
END;
IF (s='/CHECK') OR (s='SPELL') THEN BEGIN
Dec(cy);
DeleteLine(cy);
SpellCheck;
END;
IF s='/RD' THEN BEGIN
dec(cy);
deleteLine(cy);
Fun:=DoFun(RedisplayAll,dummy);
END;
IF (length(s)<=4) AND (cmpLeft(s,'/ES') OR cmpLeft(s,'/S')) THEN
Fun:=QuietExitAndSave;
IF s='/ABT' THEN Fun:=AbortPost;
END;
FUNCTION EditText:EdFun;
VAR
ch :char;
fun : edfun;
temp : linetype;
s : string;
BEGIN
Highline:=MaxLines;
WHILE (HighLine>0) AND (Len(HighLine)=0) DO
dec(Highline);
REPEAT
IF (cy>HighLine) AND (Len(cy)>0) THEN
HighLine:=cy;
IF cy>MaxLines THEN BEGIN
prompt(^G);
cy:=MaxLines;
END;
IF highline+1=MaxLines THEN
StatusLine3(c6+'One Line Left!'+c0);
IF highline=MaxLines THEN
ForceDone;
fun:=GetFun(ch);
fun:=DoFun(fun,ch);
IF (Fun=Enter) AND (len(cy-1)>1) AND (character(cy-1,1)='/') THEN
DoSlash(Fun);
IF cy>MaxLines THEN cy:=MaxLines;
IF (Fun=InsertChar) OR (Fun=InsertMCI) THEN
BEGIN
IF cx<=len(cy) THEN { Strip off trailing blanks if they don't have a color }
WHILE (character(cy,len(cy))=' ') AND (Color(line[cy]^,len(cy))='0') AND (len(cy)>cx) DO
LDelete(cy,len(cy),1);
IF Fun=InsertMCI THEN
BEGIN
MakeString(Temp,^C,CurrentColor);
Linsert(Temp,cy,cx);
Reformat(cy,true);
inc(cx);
END;
MakeString(Temp,ch,CurrentColor);
Linsert(Temp,cy,cx); { Insert it }
Reformat(cy,true);
inc(cx); { move cursor right }
END;
IF cy>ViewBottom THEN { "Scroll" the viewport down if needed }
BEGIN
ViewTop:=cy-3;
ViewBottom:=ViewTop+WindowHeight;
IF ViewBottom>MaxLines THEN
BEGIN
ViewBottom:=MaxLines;
ViewTop:=ViewBottom-WindowHeight;
END;
END;
IF cy<ViewTop THEN { "Scroll" the viewport up if needed }
BEGIN
ViewBottom:=cy+3;
ViewTop:=ViewBottom-WindowHeight;
IF ViewTop<1 THEN
BEGIN
ViewTop:=1;
ViewBottom:=ViewTop+WindowHeight;
END;
END;
Drain;
IF not KeyPressed THEN
redisplay; { Redisplay Everything that has changed }
UNTIL (fun IN [AbortPost,ExitAndSave,NormalExit,QuietExitAndSave]);
ReDisplay; { In case there are still keystrokes in the buffer [macro] }
EditText:=Fun;
END;
PROCEDURE MakeFile(i:integer; title:string);
VAR t:text;
BEGIN
IF NOT InDos THEN
BEGIN
assign(t,'RESULT.ED');
rewrite(t);
writeln(t,i);
writeln(t,title);
close(t);
END;
END;
VAR
Result : edfun; { The Result of the Visual Edit }
ReturnCode : integer; { The number returned in RESULT.ED }
BEGIN { Main }
{$IFDEF OVERLAY}
OvrInit('WWIVEdit.OVR'); Drain;
{$ENDIF}
Initialize; Drain;
{$IFDEF DIRECTVIDEO}
Translate := FALSE;
{$ENDIF}
IF NoColor OR ForceAnsi THEN
Translate:=TRUE;
FindTitle(Title,Destination); { Find title & Destination } Drain;
InitInfo; Drain;
clrscr; { Clear the Screen }
ReadInputFile(0,Filename); { Read in the Input file }
ShowHeader; { Show the message header }
Redisplay; { Show the file - If one was read it }
REPEAT
ansic(CurrentColor);
gotoxy(cx,cy+WindowTop-ViewTop); { Put the cursor in the right position }
result := EditText; { Do a visual Edit and get the result }
UNTIL Done(Result); { True it the user saves or aborts }
IF Result=AbortPost THEN ClrScr; { If the Sysop aborts it with ALT-A then clear the screen }
IF Result = QuietExitAndSave THEN
StatusLine1('');
ReturnCode:=0;
IF Result IN [ExitAndSave,QuietExitAndSave] THEN
BEGIN
WriteOutputFile(ReturnCode);
MakeFile(Returncode, Title);
END;
nl;
ansic('0'); clreol;
SaveInfo;
END. { Main }